Delphi Developer's Kit 1996/Delphi Developer's Kit 1996.iso/power/sprites/mchspbg.pas

Pascal/Delphi Source File | 1995-12-22 | 24.7 KB | 747 lines

unit MChSpBg;

{
                       Real Time Scaleable Sprites
                              Components
                                 for
                            Borland Delphi

                          Copyright 1995 by
                         Marek A. Chmielowski
                         All rights reserved

These components and source code is released to the public domain under the condition
 that it will not be used for commercial or "For Profit" ventures.
This code can be copied, used, and distributed freely providing that it is NOT
modified, no fee is charged, and it is not used in a package for which a charge
is made.

Please do NOT distribute components or source code if you altered them -
                    EVEN IF THIS IS ONLY BUG CORRECTION.
Let me know about the problem and the solution and I will implement it in the
next version (may be it will be the next version).
My e-mail:
                       76360,[e-mail]

If you would like to use this component for shareware or commercial application
please contact me first by mail:

                          Marek Chmielowski
                          5/56 Kozia St.
                          Warsaw 00-070
                          Poland
                                  or

                          Marek Chmielowski
                          10005 Broad St.
                          Bethesda, MD 20814
                          USA


}

interface

uses
  SysUtils, WinTypes, WinProcs, Messages, Classes, Graphics, Controls,
  Forms, Dialogs, ExtCtrls, Buttons, StdCtrls;

const
  NulPoint: TPoint=(x:0;y:0);
  NulRect: TRect=(left:0;top:0;right:0;bottom:0);
const
  BgrMaxSpriteNum = 100;

type
  TBgrOnInit = procedure;
  TBgrSpriteList = array[1..BgrMaxSpriteNum] of TGraphicControl;
  TDirtyReg = record
    Old: TRect;
    New: TRect;
    end;

type
  TMChSpriteBgr = class(TImage)
    { Public declarations or Published if $M+ }
  private
    { Private declarations }
    FBgrSavedOnIdle: TIdleEvent;
    FBgrInitialized: Boolean;
    FBgrSavedBgr: TBitmap;
    FBgrScreenBuf: TBitmap;
    FBgrSpritesRunning: Boolean;
    FBgrPause: Boolean;
    FBgrRespondToMouse: Boolean;
    FBgrIdleCntr: Cardinal;
    FBgrStartIdle: TDateTime;
    FBgrCntsPerSec: double;
    FBgrSpriteList:TBgrSpriteList;
    FBgrNumOfSprites: Cardinal;
    FBgrSprTmp: TGraphicControl;
    FBgrSprHitted: TGraphicControl;
    FBgrSprHittedWas: TGraphicControl;
    FBgrSprHittedIndex: Cardinal;
    FBgrSprHittedIndexWas: Cardinal;
    FBgrSprHittedAt: TPoint;
    FBgrSprWasHitted: Boolean;
    FBgrSprCaptured: TGraphicControl;
    FBgrSprCapturedIndexWas: Cardinal;
    FBgrSpriteCaptured: Boolean;
    FBgrSearchSprts: Boolean;
    FBgrOnInit: TBgrOnInit;
    FBgrInAppIdle: Boolean;
  protected
    { Protected declarations }
    procedure BgrFree;
  public
    { Public declarations }
    constructor Create(AOwner: TComponent); override;
    destructor  Destroy; override;
    procedure BgrInit;
    procedure BgrRestoreBgr;
    procedure BgrRestoreScreen;
    procedure BgrSetBackground(Bg: TBitmap);
    procedure BgrUpdateDirtyReg(Dr: TDirtyReg);
    procedure BgrUpdateDirtyRegToCanvas(Dr: TDirtyReg);
    procedure BgrEraseBufRect(Rc:TRect);
    procedure BgrScreenBufDrawMaskPaint(LeftTop: TPoint; BitMask, Bitmp: TBitmap);
    procedure BgrScreenBufStretchMaskPaint(RectToPaintTo: TRect; BitMask, Bitmp: TBitmap);
    procedure BgrScreenBufDrawRect(LeftTop: TPoint; Bitmp: TBitmap);
    procedure BgrScreenBufGetRect(RectCopyTo: TRect; BitmpCopyTo: TBitmap; RectCopyFrom: TRect);
    procedure BgrHideInBuf;
    procedure BgrShowInBuf(JT: TDateTime);
    procedure BgrUpdateBgrCanvas;
    procedure BgrGetAllSprites(BgrParent: TComponent);
    function  BgrAddTopSpr(Spr: TGraphicControl): Boolean;
    procedure BgrDeleteTopSpr;
    procedure BgrSprExchangeZ(Spr1, Spr2: TGraphicControl);
    procedure BgrSprShiftZ(SprFrom, SprDest: TGraphicControl);
    procedure BgrSprExchangeToTop(Spr: TGraphicControl);
    procedure BgrSprShiftToTop(Spr: TGraphicControl);
    procedure BgrSprIndexExchangeZ(SprI1, SprI2: Cardinal);
    procedure BgrSprIndexShiftZ(SprIFrom, SprIDest: Cardinal);
    procedure BgrSprIndexExchangeToTop(SprI: Cardinal);
    procedure BgrSprIndexShiftToTop(SprI: Cardinal);
    procedure BgrCollisionCheck(AtTime: TDateTime);
    procedure BgrAppIdle(Sender: TObject; var Done: Boolean);
    property  BgrPause: Boolean read FBgrPause write FBgrPause default False;
    property  BgrBackground: TBitmap read FBgrSavedBgr write BgrSetBackground;
    property  BgrNumOfSprites: Cardinal read FBgrNumOfSprites;
    property  BgrCntsPerSec: double read FBgrCntsPerSec;
    property  BgrIdleCntr: Cardinal read FBgrIdleCntr;
    property  BgrOnInit: TBgrOnInit read FBgrOnInit write FBgrOnInit;
    property  BgrInAppIdle: Boolean read FBgrInAppIdle;
    property  BgrSprHitted: TGraphicControl read FBgrSprHitted;
    property  BgrSprHittedWas: TGraphicControl read FBgrSprHittedWas;
    property  BgrSprHittedIndex: Cardinal read FBgrSprHittedIndex;
    property  BgrSprHittedIndexWas: Cardinal read FBgrSprHittedIndexWas;
    property  BgrSprHittedAt: TPoint read FBgrSprHittedAt;
    property  BgrSpriteWasHitted: Boolean read FBgrSprWasHitted;
    property  BgrSprCaptured: TGraphicControl read FBgrSprCaptured;
    property  BgrSprCapturedIndexWas: Cardinal read FBgrSprCapturedIndexWas;
    property  BgrSpriteCaptured: Boolean read FBgrSpriteCaptured;
    property  BgrSpritesRunning: Boolean read FBgrSpritesRunning write FBgrSpritesRunning default True;
  published
    { Published declarations - can be only class type or properties }
    procedure MChSpriteBgrMouseDown(Sender: TObject; Button: TMouseButton;
      Shift: TShiftState; X, Y: Integer);
    procedure MChSpriteBgrMouseMove(Sender: TObject;
      Shift: TShiftState; X, Y: Integer);
    procedure MChSpriteBgrMouseUp(Sender: TObject; Button: TMouseButton;
      Shift: TShiftState; X, Y: Integer);
    property  Visible;
    property  Height;
    property  Width;
    property  Left;
    property  Top;
    property  AutoSize;
    property  OnMouseDown;
    property  OnMouseMove;
    property  OnMouseUp;
    property  BgrRespondToMouse: Boolean read FBgrRespondToMouse write FBgrRespondToMouse default True;
    property  BgrSearchSprts: Boolean read FBgrSearchSprts write FBgrSearchSprts default True;
  end;

function  CheckNotNulRect(Rt: TRect):Boolean;
function  InRect(TP: TPoint; TR: TRect): Boolean;
function  DirtyReg(DOld, DNew: TRect): TDirtyReg;

procedure Register;

implementation

uses
   MChSprt;

procedure Register;
  begin
  RegisterComponents('Samples', [TMChSpriteBgr]);
  end;

constructor TMChSpriteBgr.Create(AOwner: TComponent);
  begin
  inherited Create(AOwner);
  Width:=1;
  Height:=1;
  AutoSize:=True;
  FBgrSavedBgr:=TBitmap.Create;
  FBgrScreenBuf:=TBitmap.Create;
  FBgrSavedBgr.Width:=Width;
  FBgrSavedBgr.Height:=Height;
  FBgrScreenBuf.Width:=Width;
  FBgrScreenBuf.Height:=Height;
  FBgrSpritesRunning:=True;
  FBgrRespondToMouse:=True;
  FBgrSearchSprts:=True;
  OnMouseDown := MChSpriteBgrMouseDown;
  OnMouseMove := MChSpriteBgrMouseMove;
  OnMouseUp   := MChSpriteBgrMouseUp;
  ControlStyle:=ControlStyle+[csOpaque];
  FBgrStartIdle:=time;
  FBgrSavedOnIdle := Application.OnIdle;
  Application.OnIdle := BgrAppIdle;
  end;

destructor TMChSpriteBgr.Destroy;
  begin
  Application.OnIdle := FBgrSavedOnIdle;
  BgrFree;
  inherited Destroy;
  end;

procedure TMChSpriteBgr.BgrInit;
  begin
  FBgrSavedBgr.Width:=Width;
  FBgrSavedBgr.Height:=Height;
  FBgrScreenBuf.Width:=Width;
  FBgrScreenBuf.Height:=Height;
  FBgrSavedBgr.Canvas.CopyMode:=cmSrcCopy;
  FBgrScreenBuf.Canvas.CopyMode:=cmSrcCopy;
  FBgrSavedBgr.Canvas.Draw(0,0,Picture.Graphic);
  FBgrScreenBuf.Canvas.Draw(0,0,Picture.Graphic);
  BgrGetAllSprites( (Parent as TComponent) );
  if FBgrRespondToMouse then ControlStyle:=ControlStyle+[csCaptureMouse];
  if Assigned(FBgrOnInit) then FBgrOnInit;
  FBgrInitialized := True;
  end;

procedure TMChSpriteBgr.BgrFree;
  begin
  FBgrScreenBuf.Free;
  FBgrSavedBgr.Free;
  FBgrInitialized := False;
  end;

procedure TMChSpriteBgr.BgrGetAllSprites(BgrParent: TComponent);
  var
    i, BgrCntr: Cardinal;
  begin
  if not FBgrSearchSprts then Exit;
  FBgrNumOfSprites:=0;
  BgrCntr:=0;
  if BgrParent.ComponentCount>0 then
    begin
    for i:=0 to BgrParent.ComponentCount-1 do
      if BgrParent.Components[i] is TMChSpriteBgr then inc(BgrCntr);
    if BgrCntr<2 then
      begin
      for i:=0 to BgrParent.ComponentCount-1 do
        begin
        if BgrParent.Components[i] is TMChSprite then
          begin
          if FBgrNumOfSprites<BgrMaxSpriteNum then
            begin
            inc(FBgrNumOfSprites);
            FBgrSpriteList[FBgrNumOfSprites]:=(BgrParent.Components[i] as TGraphicControl);
            (FBgrSpriteList[FBgrNumOfSprites] as TMChSprite).SprSetMgr(Self);
            (FBgrSpriteList[FBgrNumOfSprites] as TMChSprite).SprIndex:=FBgrNumOfSprites;
            end;
          end;
        end;
      end;
    end;
  end;

function  TMChSpriteBgr.BgrAddTopSpr(Spr: TGraphicControl): Boolean;
  begin
  BgrAddTopSpr:=False;
  if FBgrNumOfSprites<BgrMaxSpriteNum then
    begin
    inc(FBgrNumOfSprites);
    FBgrSpriteList[FBgrNumOfSprites]:=Spr;
    (FBgrSpriteList[FBgrNumOfSprites] as TMChSprite).SprSetMgr(Self);
    (FBgrSpriteList[FBgrNumOfSprites] as TMChSprite).SprIndex:=FBgrNumOfSprites;
    BgrAddTopSpr:=True;
    end;
  end;

procedure TMChSpriteBgr.BgrDeleteTopSpr;
  begin
  if FBgrNumOfSprites>0 then
    begin
    (FBgrSpriteList[FBgrNumOfSprites] as TMChSprite).SprUnsetMgr;
    dec(FBgrNumOfSprites);
    end;
  end;

procedure TMChSpriteBgr.BgrSprExchangeZ(Spr1, Spr2: TGraphicControl);
  begin
  BgrSprIndexExchangeZ( (Spr1 as TMChSprite).SprIndex, (Spr2 as TMChSprite).SprIndex );
  end;

procedure TMChSpriteBgr.BgrSprShiftZ(SprFrom, SprDest: TGraphicControl);
  begin
  BgrSprIndexShiftZ( (SprFrom as TMChSprite).SprIndex, (SprDest as TMChSprite).SprIndex );
  end;

procedure TMChSpriteBgr.BgrSprExchangeToTop(Spr: TGraphicControl);
  begin
  BgrSprIndexExchangeToTop( (Spr as TMChSprite).SprIndex );
  end;

procedure TMChSpriteBgr.BgrSprShiftToTop(Spr: TGraphicControl);
  begin
  BgrSprIndexShiftToTop( (Spr as TMChSprite).SprIndex );
  end;

procedure TMChSpriteBgr.BgrSprIndexExchangeZ(SprI1, SprI2: Cardinal);
  var
    i: Cardinal;
  begin
  if (SprI1>FBgrNumOfSprites) or (SprI2>FBgrNumOfSprites) or (SprI1=SprI2) or
     (SprI1=0) or (SprI2=0) then exit;
  BgrPause:=True;
  FBgrSprTmp:=FBgrSpriteList[SprI1];
  FBgrSpriteList[SprI1]:=FBgrSpriteList[SprI2];
  (FBgrSpriteList[SprI1] as TMChSprite).SprIndex:=SprI1;
  (FBgrSpriteList[SprI1] as TMChSprite).SprRepaint:=True;
  FBgrSpriteList[Spri2]:=FBgrSprTmp;
  (FBgrSpriteList[Spri2] as TMChSprite).SprIndex:=SprI2;
  (FBgrSpriteList[SprI2] as TMChSprite).SprRepaint:=True;
  BgrPause:=False;
  end;

procedure TMChSpriteBgr.BgrSprIndexShiftZ(SprIFrom, SprIDest: Cardinal);
  var
    i, SprILo, SprIHi: Cardinal;
  begin
  if (SprIFrom>FBgrNumOfSprites) or (SprIDest>FBgrNumOfSprites) or (SprIFrom=SprIDest) or
     (SprIFrom=0) or (SprIDest=0) then exit;
  if SprIFrom>SprIDest then
    begin
    SprILo:=SprIDest;
    SprIHi:=SprIFrom;
    end
  else
    begin
    SprILo:=SprIFrom;
    SprIHi:=SprIDest;
    end;
  BgrPause:=True;
  if SprIFrom<SprIDest then
    begin
    FBgrSprTmp:=FBgrSpriteList[SprIFrom];
    i:=SprIFrom;
    while i<SprIDest do
      begin
      FBgrSpriteList[i]:=FBgrSpriteList[i+1];
      (FBgrSpriteList[i] as TMChSprite).SprIndex:=i;
      (FBgrSpriteList[i] as TMChSprite).SprRepaint:=True;
      inc(i);
      end;
    FBgrSpriteList[i]:=FBgrSprTmp;
    (FBgrSpriteList[i] as TMChSprite).SprIndex:=i;
    (FBgrSpriteList[i] as TMChSprite).SprRepaint:=True;
    end
  else
    begin
    FBgrSprTmp:=FBgrSpriteList[SprIFrom];
    i:=SprIFrom;
    while i>SprIDest do
      begin
      FBgrSpriteList[i]:=FBgrSpriteList[i-1];
      (FBgrSpriteList[i] as TMChSprite).SprIndex:=i;
      (FBgrSpriteList[i] as TMChSprite).SprRepaint:=True;
      dec(i);
      end;
    FBgrSpriteList[i]:=FBgrSprTmp;
    (FBgrSpriteList[i] as TMChSprite).SprIndex:=i;
    (FBgrSpriteList[i] as TMChSprite).SprRepaint:=True;
    end;
    BgrPause:=False;
  end;

procedure TMChSpriteBgr.BgrSprIndexExchangeToTop(SprI: Cardinal);
  begin
  if (SprI<FBgrNumOfSprites) and (SprI>0) then BgrSprIndexExchangeZ(SprI, FBgrNumOfSprites);
  end;

procedure TMChSpriteBgr.BgrSprIndexShiftToTop(SprI: Cardinal);
  begin
  if (SprI<FBgrNumOfSprites) and (SprI>0) then BgrSprIndexShiftZ(SprI, FBgrNumOfSprites);
  end;

procedure TMChSpriteBgr.BgrSetBackground(Bg: TBitmap);
  var
    i: Cardinal;
  begin
  Width :=Bg.Width;
  Height:=Bg.Height;
  FBgrSavedBgr.Width   := Bg.Width;
  FBgrSavedBgr.Height  := Bg.Height;
  FBgrScreenBuf.Width  := Bg.Width;
  FBgrScreenBuf.Height := Bg.Height;
  FBgrSavedBgr.Canvas.CopyMode:=cmSrcCopy;
  FBgrSavedBgr.Canvas.Draw(0,0,Bg);
  FBgrScreenBuf.Canvas.CopyMode:=cmSrcCopy;
  FBgrScreenBuf.Canvas.Draw(0,0,FBgrSavedBgr);
  Picture.Graphic:=Bg;
  Canvas.Draw(0,0,FBgrScreenBuf);
  if FBgrNumOfSprites>0 then
    for i:=1 to FBgrNumOfSprites do (FBgrSpriteList[i] as TMChSprite).SprRepaint:=True;
end;

procedure TMChSpriteBgr.BgrRestoreBgr;
  begin
  if not FBgrInitialized then BgrInit;
  if Assigned(FBgrSavedBgr) and not FBgrSavedBgr.Empty then
    begin
    Canvas.CopyMode := cmSrcCopy;
    Canvas.CopyRect(Rect(0,0,Width,Height),
                    FBgrSavedBgr.Canvas,
                    Rect(0,0,FBgrSavedBgr.Width,FBgrSavedBgr.Height) );
    end;
  end;

procedure TMChSpriteBgr.BgrRestoreScreen;
  var
    i: Cardinal;
  begin
  if not FBgrInitialized then BgrInit;
  if Assigned(FBgrScreenBuf) and (not FBgrScreenBuf.Empty) then
    begin
    Canvas.CopyMode := cmSrcCopy;
    Canvas.CopyRect(Rect(0,0,Width,Height),
                    FBgrScreenBuf.Canvas,
                    Rect(0,0,FBgrScreenBuf.Width,FBgrScreenBuf.Height) );
    if FBgrNumOfSprites>0 then
      for i:=1 to FBgrNumOfSprites do (FBgrSpriteList[i] as TMChSprite).SprRepaint:=True;
    end;
  end;

procedure TMChSpriteBgr.BgrEraseBufRect(Rc:TRect);
  begin
  if not FBgrInitialized then BgrInit;
  if Assigned(FBgrScreenBuf) and not FBgrScreenBuf.Empty and
     Assigned(FBgrSavedBgr) and not FBgrSavedBgr.Empty then
    begin
    FBgrScreenBuf.Canvas.CopyMode := cmSrcCopy;
    FBgrScreenBuf.Canvas.CopyRect(Rc,
                    FBgrSavedBgr.Canvas,
                    Rc);
    end;
  end;

procedure TMChSpriteBgr.BgrUpdateDirtyReg(Dr: TDirtyReg);
  var
    URect: TRect;
  begin
  if not FBgrInitialized then BgrInit;
  if 0<>IntersectRect(URect,Dr.Old,Dr.New) then
    begin
    if 0<>UnionRect(URect, Dr.Old,Dr.New) then
      if Assigned(FBgrScreenBuf) and not FBgrScreenBuf.Empty then
        begin
        if CheckNotNulRect(URect) then
          begin
          Canvas.CopyMode := cmSrcCopy;
          Canvas.CopyRect(URect,FBgrScreenBuf.Canvas,URect);
          end;
        end;
    end
  else
    begin
    if Assigned(FBgrScreenBuf) and not FBgrScreenBuf.Empty then
      begin
      if CheckNotNulRect(Dr.Old) or CheckNotNulRect(Dr.New) then
        begin
        Canvas.CopyMode := cmSrcCopy;
        if CheckNotNulRect(Dr.Old) then Canvas.CopyRect(Dr.Old,FBgrScreenBuf.Canvas,Dr.Old);
        if CheckNotNulRect(Dr.New) then Canvas.CopyRect(Dr.New,FBgrScreenBuf.Canvas,Dr.New);
        end;
      end;
    end;
  end;

procedure TMChSpriteBgr.BgrUpdateDirtyRegToCanvas(Dr: TDirtyReg);
  var
    URect,UURect,DDrOld,DDrNew: TRect;
    ImgPos: TPoint;
  begin
  ImgPos.x:= Left;
  ImgPos.y:= Top;
  if 0<>IntersectRect(URect,Dr.Old,Dr.New) then
    begin
    if 0<>UnionRect(URect, Dr.Old,Dr.New) then
      if Assigned(FBgrScreenBuf) and not FBgrScreenBuf.Empty then
        begin
        if CheckNotNulRect(URect) then
          begin
          UURect:=Rect(ImgPos.x+URect.left,ImgPos.y+URect.Top,ImgPos.x+URect.right,ImgPos.y+URect.bottom);
          (Parent as TForm).Canvas.CopyMode := cmSrcCopy;
          (Parent as TForm).Canvas.CopyRect(UURect,FBgrScreenBuf.Canvas,URect);
          end;
        end;
    end
  else
    begin
    if Assigned(FBgrScreenBuf) and not FBgrScreenBuf.Empty then
      begin
      if CheckNotNulRect(Dr.Old) or CheckNotNulRect(Dr.New) then
        begin
        DDrOld:=Rect(ImgPos.x+Dr.Old.left,ImgPos.y+Dr.Old.Top,ImgPos.x+Dr.Old.right,ImgPos.y+Dr.Old.bottom);
        DDrNew:=Rect(ImgPos.x+Dr.New.left,ImgPos.y+Dr.New.Top,ImgPos.x+Dr.New.right,ImgPos.y+Dr.New.bottom);
        (Parent as TForm).Canvas.CopyMode := cmSrcCopy;
        if CheckNotNulRect(Dr.Old) then (Parent as TForm).Canvas.CopyRect(DDrOld,FBgrScreenBuf.Canvas,Dr.Old);
        if CheckNotNulRect(Dr.New) then (Parent as TForm).Canvas.CopyRect(DDrNew,FBgrScreenBuf.Canvas,Dr.New);
        end;
      end;
    end;
  end;

procedure TMChSpriteBgr.BgrScreenBufDrawMaskPaint(LeftTop: TPoint; BitMask, Bitmp: TBitmap);
  begin
  FBgrScreenBuf.Canvas.CopyMode := cmSrcAnd;
  FBgrScreenBuf.Canvas.Draw(LeftTop.x,LeftTop.y,BitMask);
  FBgrScreenBuf.Canvas.CopyMode := cmSrcPaint;
  FBgrScreenBuf.Canvas.Draw(LeftTop.x,LeftTop.y,Bitmp);
  end;

procedure TMChSpriteBgr.BgrScreenBufStretchMaskPaint(RectToPaintTo: TRect; BitMask, Bitmp: TBitmap);
  begin
  FBgrScreenBuf.Canvas.CopyMode:=cmSrcAnd;
  FBgrScreenBuf.Canvas.StretchDraw(RectToPaintTo,BitMask);
  FBgrScreenBuf.Canvas.CopyMode:=cmSrcPaint;
  FBgrScreenBuf.Canvas.StretchDraw(RectToPaintTo,Bitmp);
  end;

procedure TMChSpriteBgr.BgrScreenBufDrawRect(LeftTop: TPoint; Bitmp: TBitmap);
  begin
  FBgrScreenBuf.Canvas.CopyMode := cmSrcCopy;
  FBgrScreenBuf.Canvas.Draw(LeftTop.x,LeftTop.y,Bitmp);
  end;

procedure TMChSpriteBgr.BgrScreenBufGetRect(RectCopyTo: TRect; BitmpCopyTo: TBitmap; RectCopyFrom: TRect);
  begin
  BitmpCopyTo.Canvas.CopyMode:=cmSrcCopy;
  BitmpCopyTo.Canvas.CopyRect(RectCopyTo,FBgrScreenBuf.Canvas,RectCopyFrom);
  end;

procedure TMChSpriteBgr.BgrHideInBuf;
  var
    i: Cardinal;
  begin
  if FBgrNumOfSprites<1 then exit;
  for i:=1 to FBgrNumOfSprites do
    begin
    (FBgrSpriteList[i] as TMChSprite).SprHideTmp;
    end;
  end;

procedure TMChSpriteBgr.BgrShowInBuf(JT: TDateTime);
  var
    i: Cardinal;
  begin
  if FBgrNumOfSprites<1 then exit;
  for i:=1 to FBgrNumOfSprites do
    begin
    (FBgrSpriteList[i] as TMChSprite).SprShowAtTime(JT);
    end;
  end;

procedure TMChSpriteBgr.BgrUpdateBgrCanvas;
  var
    i: Cardinal;
  begin
  if FBgrNumOfSprites<1 then exit;
  for i:=1 to FBgrNumOfSprites do
    begin
    BgrUpdateDirtyReg( (FBgrSpriteList[i] as TMChSprite).SprGetDirty );
    end;
  end;


procedure TMChSpriteBgr.BgrAppIdle(Sender: TObject; var Done: Boolean);
  var
    i: Cardinal;
    JumpTime, TestTime: TDateTime;
  begin
  if not FBgrInitialized then BgrInit;
  try
    if FBgrSpritesRunning and not BgrPause and (FBgrNumOfSprites>0) then
      begin
      FBgrInAppIdle:=True;
      Done := False;
      BgrHideInBuf;
      JumpTime:=time;
      BgrCollisionCheck(JumpTime);
      BgrShowInBuf(JumpTime);
      BgrUpdateBgrCanvas;
      end;
  finally
      TestTime:=time;
      if FBgrIdleCntr<100 then
        begin
        inc(FBgrIdleCntr);
        if (FBgrIdleCntr>=10) and ((TestTime-FBgrStartIdle)*24.0*60.0*60.0>1.0)
          then FBgrCntsPerSec:=FBgrIdleCntr/((time-FBgrStartIdle)*24.0*60.0*60.0);
        end
      else
        begin
        if ((TestTime-FBgrStartIdle)*24.0*60.0*60.0>1.0) then
          FBgrCntsPerSec:=FBgrIdleCntr/((TestTime-FBgrStartIdle)*24.0*60.0*60.0);
        FBgrStartIdle:=time;
        FBgrIdleCntr:=1;
        end;
      FBgrInAppIdle:=False;
      if Assigned(FBgrSavedOnIdle) then
        if not (Sender is TMChSprite) then FBgrSavedOnIdle(Self, Done);
    end;
  end;

function  CheckNotNulRect(Rt: TRect):Boolean;
  begin
  if (Rt.Left=0) and (Rt.Top=0) and (Rt.Right=0) and (Rt.Bottom=0) then
    CheckNotNulRect:=False
  else CheckNotNulRect:=True;
  end;

function  InRect(TP: TPoint; TR: TRect): Boolean;
  begin
  if (
     ((TR.Left< TR.Right) and (TR.Left<=TP.x) and (TP.x<=TR.Right)) or
     ((TR.Left>=TR.Right) and (TR.Left>=TP.x) and (TP.x>=TR.Right))
     ) and
     (
     ((TR.Top< TR.Bottom) and (TR.Top <=TP.y) and (TP.y<=TR.Bottom)) or
     ((TR.Top>=TR.Bottom) and (TR.Top >=TP.y) and (TP.y>=TR.Bottom))
     )
     then InRect:=True
     else InRect:=False;
  end;

function  DirtyReg(DOld, DNew: TRect): TDirtyReg;
  begin
  DirtyReg.Old:=DOld;
  DirtyReg.New:=DNew;
  end;

procedure TMChSpriteBgr.MChSpriteBgrMouseDown(Sender: TObject;
  Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
  var
    i: Cardinal;
  begin
  if FBgrNumOfSprites<1 then exit;
  if FBgrRespondToMouse and (Button=mbLeft) then
    begin
    for i:=FBgrNumOfSprites downto 1 do
      begin
      if (FBgrSpriteList[i] as TMChSprite).SprHitTest(Point(X,Y)) then
        begin
        FBgrSprHitted:=FBgrSpriteList[i];
        FBgrSprHittedWas:=FBgrSprHitted;
        FBgrSprHittedIndex:=i;
        FBgrSprHittedIndexWas:=i;
        FBgrSprHittedAt:=(FBgrSprHitted as TMChSprite).SprHitAt(Point(X,Y));
        FBgrSprWasHitted:=True;
        Break;
        end;
      end;
    if Assigned(FBgrSprHitted) and (FBgrSprHitted as TMChSprite).SprDragable then
      begin
      FBgrSprCaptured:=FBgrSprHitted;
      FBgrSprCapturedIndexWas:=FBgrSprHittedIndex;
      FBgrSpriteCaptured:=True;
      BgrSprIndexExchangeToTop(FBgrSprHittedIndex);
      (FBgrSprCaptured as TMChSprite).SprPaused:=True;
      end;
    end;
  end;

procedure TMChSpriteBgr.MChSpriteBgrMouseMove(Sender: TObject;
  Shift: TShiftState; X, Y: Integer);
  begin
  if FBgrSpriteCaptured then
    begin
    (FBgrSprCaptured as TMChSprite).SprShowAt(Point(X-FBgrSprHittedAt.x,Y-FBgrSprHittedAt.y));
    end;
  end;

procedure TMChSpriteBgr.MChSpriteBgrMouseUp(Sender: TObject;
  Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
  begin
  if (Button=mbLeft) and FBgrSprWasHitted then
    begin
    FBgrSprHitted:=nil;
    FBgrSprHittedIndex:=0;
    FBgrSprHittedAt:=NulPoint;
    FBgrSprWasHitted:=False;
    if FBgrSpriteCaptured then
      begin
      if FBgrSprCapturedIndexWas<FBgrNumOfSprites then BgrSprIndexExchangeZ(FBgrNumOfSprites,FBgrSprCapturedIndexWas);
      (FBgrSprCaptured as TMChSprite).SprPaused:=False;
      FBgrSpriteCaptured:=False;
      FBgrSprCaptured:=nil;
      FBgrSprCapturedIndexWas:=0;
      end;
    end;
  end;

procedure TMChSpriteBgr.BgrCollisionCheck(AtTime: TDateTime);
  var
    i,j: Cardinal;
    BreakAll: Boolean;
    SprCollided: array[1..BgrMaxSpriteNum] of Boolean;
  begin
  if FBgrNumOfSprites<=1 then exit;
  BreakAll:=False;
  for i:=1 to FBgrNumOfSprites do SprCollided[i]:=False;
  for i:=FBgrNumOfSprites downto 2 do
    begin
    if (FBgrSpriteList[i] as TMChSprite).SprColliding then
      begin
      if Assigned((FBgrSpriteList[i] as TMChSprite).FSprOnBorder) and
         (FBgrSpriteList[i] as TMChSprite).SprCheckBorders(AtTime) then
           (FBgrSpriteList[i] as TMChSprite).SprOnBorder(AtTime);
      for j:=i-1 downto 1 do
        begin
        if (FBgrSpriteList[i] as TMChSprite).SprCheckCollision((FBgrSpriteList[j] as TMChSprite),AtTime) then
          begin
          SprCollided[i]:=True;
          SprCollided[j]:=True;
          if Assigned((FBgrSpriteList[i] as TMChSprite).FSprOnCollide) then
            (FBgrSpriteList[i] as TMChSprite).SprOnCollide((FBgrSpriteList[j] as TMChSprite),AtTime)
          else
            if Assigned((FBgrSpriteList[j] as TMChSprite).FSprOnCollide) then
              (FBgrSpriteList[j] as TMChSprite).SprOnCollide((FBgrSpriteList[i] as TMChSprite),AtTime);
          if ((FBgrSpriteList[i] as TMChSprite).SprCollisionMask) or
             ((FBgrSpriteList[j] as TMChSprite).SprCollisionMask)
            then
            begin
            BreakAll:=True;
            Break; {Detect only single collision - SprOnCollide can change FBgrSpriteList }
            end;
          end;
        end;
        if (not SprCollided[i]) and Assigned((FBgrSpriteList[i] as TMChSprite).FSprNoCollide) then
                (FBgrSpriteList[i] as TMChSprite).SprNoCollide(AtTime);
      end;
    if BreakAll then Break
    else if (i=2) and (not SprCollided[1]) and (FBgrSpriteList[1] as TMChSprite).SprColliding and
           Assigned((FBgrSpriteList[1] as TMChSprite).FSprNoCollide)
      then (FBgrSpriteList[1] as TMChSprite).SprNoCollide(AtTime);
    end;
  end;

end.